home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / Clinic / NameHlpU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-06-01  |  3.5 KB  |  133 lines
  1. unit NameHlpU;
  2.  
  3. {$ifdef Ver90} //Delphi 2
  4.   {$define Delphi2}
  5. {$endif}
  6. {$ifdef Ver93} //BCB1
  7.   {$define Delphi2}
  8. {$endif}
  9.  
  10. interface
  11.  
  12. uses
  13. {$ifdef Delphi2} //BCB1
  14.   OLE2,
  15. {$endif}
  16.   ShlObj,
  17.   Classes;
  18.  
  19. function CreateFolderObject(const ClsID: TGuid): IShellFolder;
  20. procedure GetFolderItems(Folder: IShellFolder; List: TStrings);
  21. function GetSpecialFolderClsID(const FolderName: String): TGuid;
  22. function GetSpecialFolderLocation(Folder: Cardinal): String;
  23.  
  24. implementation
  25.  
  26. uses
  27. {$ifdef Delphi2}
  28.   OleAuto,
  29. {$else}
  30.   ComObj, ActiveX,
  31. {$endif}
  32.   Forms, Windows, SysUtils, Registry, IniFiles;
  33.  
  34. var
  35.   Malloc: IMalloc;
  36.  
  37. function CreateFolderObject(const ClsID: TGuid): IShellFolder;
  38. begin
  39. {$ifdef Delphi2}
  40.   OleCheck(CoCreateInstance(ClsID, nil, CLSCTX_INPROC_SERVER or
  41.     CLSCTX_LOCAL_SERVER, IID_IShellFolder, Result));
  42. {$else}
  43.   Result := CreateCOMObject(ClsID) as IShellFolder
  44. {$endif}
  45. end;
  46.  
  47. procedure GetFolderItems(Folder: IShellFolder; List: TStrings);
  48. var
  49.   Enum: IEnumIDList;
  50.   PIDL: PItemIDList;
  51.   Fetched: {$ifdef Delphi2}ULong{$else}DWord{$endif};
  52.   StrRet: TStrRet;
  53. begin
  54.   //Get enumeration object, just for files - not folders
  55.   OleCheck(Folder.EnumObjects(
  56.     Application.Handle, SHCONTF_NONFOLDERS, Enum));
  57.   List.BeginUpdate;
  58.   try
  59.     List.Clear;
  60.     //Get 1 item at a time. Not efficient, but still...
  61.     while (Enum.Next(1, PIDL, Fetched) = NOERROR) and (Fetched = 1) do
  62.     begin
  63.       //Ask for the name
  64.       OleCheck(Folder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, StrRet));
  65.       //It may come back in a number of formats
  66.       case StrRet.uType of
  67.         STRRET_WSTR:
  68.         begin
  69.           List.Add(WideCharToString(StrRet.pOleStr));
  70.           Malloc.Free(StrRet.pOleStr)
  71.         end;
  72.         STRRET_OFFSET:
  73.           List.Add(PChar(Cardinal(PIDL) + StrRet.uOffset));
  74.         STRRET_CSTR:
  75.           List.Add(StrRet.cStr);
  76.       end;
  77.       //Free item
  78.       Malloc.Free(PIDL);
  79.     end;
  80.   finally
  81.     List.EndUpdate
  82.   end
  83. end;
  84.  
  85. function GetSpecialFolderClsID(const FolderName: String): TGuid;
  86. var
  87.   ClsID: String;
  88. {$ifdef Delphi2}
  89. const
  90.   REGSTR_PATH_EXPLORER        = 'Software\Microsoft\Windows\CurrentVersion\Explorer';
  91.   REGSTR_PATH_SPECIAL_FOLDERS = REGSTR_PATH_EXPLORER + '\Shell Folders';
  92. {$endif}
  93. begin
  94.   with TRegistry.Create do
  95.     try
  96.       //Locate special folders in registry
  97.       if OpenKey(REGSTR_PATH_SPECIAL_FOLDERS, False) then
  98.         //Read requested folder name & read DESKTOP.INI
  99.         with TIniFile.Create(ReadString(FolderName) + '\DESKTOP.INI') do
  100.           try
  101.             //Entry should be marked as CLSID or UICLSID
  102.             ClsID := ReadString('.ShellClassInfo', 'CLSID', '');
  103.             if ClsID = '' then
  104.               ClsID := ReadString('.ShellClassInfo', 'UICLSID', '');
  105.             //Translate from string to real GUID record
  106.             Result := {$ifdef Delphi2}StringToClassID(ClsID){$else}StringToGUID(ClsID){$endif}
  107.           finally
  108.             Free //delete TIniFile
  109.           end;
  110.     finally
  111.       Free //Delete TRegistry
  112.     end;
  113. end;
  114.  
  115. function GetSpecialFolderLocation(Folder: Cardinal): String;
  116. var
  117.   PIDList: PItemIDList;
  118.   Buf: array[0..MAX_PATH] of Char;
  119. begin
  120.   Result := 'Not available';
  121.   if (SHGetSpecialFolderLocation(
  122.         Application.Handle, Folder, PIDList) = NOERROR) and
  123.      SHGetPathFromIDList(PIDList, Buf) then
  124.   begin
  125.     Result := Buf;
  126.     Malloc.Free(PIDList)
  127.   end
  128. end;
  129.  
  130. initialization
  131.   ShGetMalloc(Malloc);
  132. end.
  133.